Developer CD Series 1998 November: Tool Chest/Dev.CD Nov 98 TC.toast/Tool Chest/Development Kits/MPW etc./Debuggers/SADE/SADE 1.3.3/SADE Example Scripts/MiscProcs

Text File | 1991-07-29 | 5.5 KB | 165 lines | [TEXT/sade]

#    Symbolic Application Debugging Environment    1.3 Final
#
#    Copyright Apple Computer, Inc. 1987-1991
#    All rights reserved.
###############################################################################
# displays the title of each window in the window list.
proc displaywindowlist;

define awindow;            # used to contain the pointer to each window record in turn

    awindow := ^WindowRecord(windowlist);    # start at the first window, pointed to from low memory.
    while (awindow <> 0) do    # a NIL terminated list.
        printf ("Window Title = \"%P\"\n",^pString(awindow^.titleHandle^)^);        # write the information out.
        awindow := ^WindowRecord(awindow^.nextWindow);        # point at the next in the list.
    end;

end; # displaywindowlist


###############################################################################
# a small set of routines to list out all of the FCBs

#-------------------------------------------------------------------------------------------
#    FCBLen --     returns the length of the FCB, 20 if we are running MFS (which we won't ever be)
#                or what's in $3F6 if HFS.
#-------------------------------------------------------------------------------------------
func FCBLen    ()

define FSFCBLen := ^word($3F6)^                    # fetch value of low-memory global
define MFSFCBLen := 20                            # we know this to be true, for ever and ever

    if (FSFCBLen < 0)                             # less than zero means MFS
        return(MFSFCBLen);
    else
        return(FSFCBLen);
    end
end    # func FCBLen


#-------------------------------------------------------------------------------------------
#    DisplayAnFCB -- displays the entryNumth entry in the FCB table.  Does NOT check to see
#                    if the entry is actually in the table, that's left to the caller
#-------------------------------------------------------------------------------------------
proc DisplayAnFCB(entryNum)

define theFCBsAddr,theRefNum
# the following are offsets into the FCB
define fileNumOffset := 0;
define PEOFOffset := 12;
define fileTypeOffset := 50;
define fileNameOffset := 62;

    theRefNum := (entryNum * FCBLen()) + 2;     # "+2" accounts for the length word at the
                                                # start of the FCB block
    theFCBsAddr:= FCBsPtr^+ theRefNum;

    printf("$%.4X",theRefNum);                     # print the refnum
    if (theFCBsAddr+fileNumOffset)^ = 0         # the file is unused
        printf("     unused\n");
    else
        printf("     $%.8X",(theFCBsAddr+fileNumOffset)^);    # print the file number
        printf("     $%.8X",(theFCBsAddr+PEOFOffset)^);
        printf("     %#s",(theFCBsAddr+fileTypeOffset)^);
        printf("     %P\n",^pstring(theFCBsAddr+fileNameOffset)^);
    end
END;  # proc DisplayAnFCB


#-------------------------------------------------------------------------------------------
#    DisplayFCBs -- loops through and lists all FCBs by calling DisplayAnFCB
#-------------------------------------------------------------------------------------------
proc DisplayFCBs

# global variable
define global FCBsPtr  := $34E                    # location of pointer to FCBs

define i,numFCBs

    # print header
    numFCBs:= ^Word(FCBsPtr^)^ / FCBLen();     # we don't really need this variable, but what the hey
    printf("There are %t FCBs starting at $%.8X\n\n",numFCBs,FCBsPtr^);
    printf("RefNum    File#         PEOF          FType    Name\n");
    printf("------    -----         ----          -----    ----\n");

    for i:= 0 to numFCBs-1                        # FCB table is zero based
        DisplayAnFCB(i)                          # display this FCB
    end    #for
    undefine FCBsPtr;
end; # proc DisplayFCBs


###############################################################################
# this proc creates a listing in the specified output file.
# The listing will have each statement of the specified routine
# followed by a disassembly of the code associated with the statement.
# It isn't very pretty, but it might help you spot code generation bugs.
# Note that the routine to be listed must be in a loaded segment.
    proc InterList(myRoutine,myOutput)
        open myOutput; redirect myOutput
        define looper := 0, junk
        define currentLine, previousLine, lastLine
        currentLine := eval(concat (myroutine,'.(looper)'), '???')    # start with statement 0
            if (TypeOf(currentLine) = 'PString')
                printf "cannot find program symbol ∂"%t∂"\n",myroutine
                redirect pop
                return
            end
        junk := addrtosource(currentLine)                                        # select the statement
            if (junk != 1)
                printf "cannot find the source for ∂"%t∂"\n",myRoutine
                redirect pop
                return
            end
        selection(targetwindow)                                                            # echo the statement
        disasm currentLine..eval(concat (myroutine,'.(looper+1)'))-1 # add the instructions
        " "
        lastLine := eval(concat (myroutine,'.(1000000)'))        # so we can detect the end
        for looper := 1 to 1000000
            previousLine := eval(concat (myroutine,'.(looper-1)')) # so we can detect duplicates
            leave if ( previousLine = lastLine)                                # all done
            currentLine := eval(concat (myroutine,'.(looper)'))
            if (currentLine != previousLine)                                    # if not a duplicate
                junk := addrtosource(currentLine)
                selection(targetWindow)
                " "
                disasm currentLine..eval(concat (myroutine,'.(looper+1)'))-1
                " "
            end
        end
        redirect pop
    end


# example usage

# InterList('routinename','filename')


###############################################################################
# for the numerically minded--how many debuggers can do factorial?

func fact(n)
    if n <= 1.0 then
        return 1.0
    else
        return n * fact(n-1)
    end
end


proc factorial (n,file)
    define i
    if nargs>1 then
        redirect file
    end
    for i := 1 to n do
        printf("fact(%.2d) = %19.19g\n",i,fact(i))
    end
    if nargs>1 then
        redirect
    end
end